home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr48
/
pavt117.zip
/
AVIDEO.INC
next >
Wrap
Text File
|
1993-04-24
|
5KB
|
216 lines
{ Include file for the demo programs in PAvatar. }
{ These are the video and user hook routines }
{ if the compiler directive AVT0 is set then it }
{ will compile to be compatible with the PAvt0 }
{ unit. Otherwise PAvt1 is assumed. }
type
ScreenWord = record
chr : char;
attr : byte;
end;
ScreenPtr = ^Screen;
Screen = Array[1..25,1..80] of ScreenWord;
var
ScrPtr : ScreenPtr; { for direct screen writes }
{$IFDEF VER55}
Function DV_Get_Video_Buffer(cseg:word): word;
begin
if DESQview_version = 0 then DV_Get_Video_Buffer := cseg
else
InLine(
$b4/$fe/ { MOV AH,0FEH DV's get video buffer function }
$cd/$10/ { INT 10H Returns ES:DI of alt buffer }
$8c/$c0); { MOV AX,ES Return video buffer }
end; { DV_Get_Video_Buffer }
{$ELSE}
Function DV_Get_Video_Buffer(cseg:word): word; assembler;
asm
MOV ES,cseg { Put current segment into ES }
CALL DESQview_version { Returns AX=0 if not in DV }
TEST AX,AX { In DV? }
JZ @DVGVB_X { Jump if not }
MOV AH,0FEH { DV's get video buffer function }
INT 10H { Returns ES:DI of alt buffer }
MOV AX,ES { Return video buffer }
JMP @DVGVB_E { Exit and return DV buffer }
@DVGVB_X:
MOV AX,cseg { Load old buffer for return to caller }
@DVGVB_E:
end; { DV_Get_Video_Buffer }
{$ENDIF}
Procedure SetScrPtr;
var
sg : word;
begin
if LastMode = 7 then sg := $B000
else sg := $B800;
sg := DV_Get_Video_Buffer(sg);
ScrPtr := Ptr(sg,$0000);
end;
(* Hooks *)
procedure FillWord(var x; count:integer; w:word);
begin
Inline(
$c4/$be/x/
$8b/$86/w/
$8b/$8e/count/
$f2/$ab);
(* LES DI,x { load target address }
MOV AX,w { load word to fill in }
MOV CX,count { number of words to move }
REPNZ STOSW { copy the data } *)
end;
procedure MoveW(var Source, Dest; count:integer);
begin { Only good for single direction, moves to screen }
Inline(
$8c/$db/
$c4/$be/Dest/
$c5/$b6/Source/
$8b/$8e/count/
$f2/$a5/
$8e/$db);
(* MOV BX,DS { Save DS }
LES DI,Dest { Load destination ptr }
LDS SI,Source { load source ptr }
MOV CX,Count { load # of words to move }
REPNZ MOVSW { move 'em }
MOV DS,BX { restore DS } *)
end;
procedure GetXY(var x,y:byte);
begin
x := WhereX;
y := WhereY;
end;
{$F+}
procedure SetXY(x,y:byte);
begin
GotoXY(x,y);
end;
procedure WriteAT(x,y,a:byte;ch:char);
begin
with ScrPtr^[y,x] do
begin
attr := a;
chr := ch;
end;
end;
procedure FillArea(x1,y1,x2,y2,a:byte;ch:char);
var
sw : screenword;
w : byte;
begin
if x1 > x2 then x1 := x2;
if y1 > y2 then y1 := y2;
sw.chr := ch;
sw.attr := a;
w := succ(x2-x1);
for y1 := y1 to y2 do
FillWord(ScrPtr^[y1,x1],w,word(sw));
end;
procedure Scroll(dir,x1,y1,x2,y2,n,a:byte);
var
t : byte;
begin
if x1 > x2 then x1 := x2;
if y1 > y2 then y1 := y2;
if n = 0 then
begin
FillArea(x1,y1,x2,y2,a,' ');
exit;
end;
case dir of
1 : begin { up }
if n > succ(y2-y1) then n := succ(y2-y1);
for t := y1+n to y2 do
MoveW(ScrPtr^[t,x1], ScrPtr^[t-n,x1], succ(x2-x1)); { move a line }
FillArea(x1,succ(y2-n),x2,y2,a,' ');
end;
2 : begin { down }
if n > succ(y2-y1) then n := succ(y2-y1);
for t := y2-n downto y1 do
MoveW(ScrPtr^[t,x1], ScrPtr^[t+n,x1], succ(x2-x1)); { move a line }
FillArea(x1,y1,x2,pred(y1+n),a,' ');
end;
3 : begin { left }
if n > succ(x2-x1) then n := succ(x2-x1);
for t := y1 to y2 do
MoveW(ScrPtr^[t,x1+n], ScrPtr^[t,x1], succ(x2-(x1+n)));
FillArea(succ(x2-n),y1,x2,y2,a,' ');
end;
4 : begin { right }
if n > succ(x2-x1) then n := succ(x2-x1);
for t := y1 to y2 do
MoveW(ScrPtr^[t,x1], ScrPtr^[t,x1+n], succ(x2-(x1+n)));
FillArea(x1,y1,pred(x1+n),y2,a,' ');
end;
end; { case dir }
end;
procedure GetScrChar(x,y:byte;var a:byte;var c:char);
begin
with ScrPtr^[y,x] do
begin
a := attr;
c := chr;
end;
end;
procedure HighArea(x1,y1,x2,y2,a:byte);
var
i,j,m : byte;
c : char;
begin
if x1 > x2 then x1 := x2;
if y1 > y2 then y1 := y2;
for i := x1 to x2 do
for j := y1 to y2 do
begin
GetScrChar(i,j,m,c);
WriteAT(i,j,a,c);
end;
end;
{$IFNDEF AVT0}
procedure Pause(tens:word);
begin
for tens := tens downto 1 do
begin
delay(100); { note that delay usually isn't accurate }
if KeyPressed then tens := 1; { abort the pause }
end;
end;
{$ENDIF}
{$F-}
(* End Hook Definitions *)
procedure SetHooks;
begin
{ Query_Hook := <defualt null hook for this application> }
{$IFNDEF AVT0}
Pauseh := Pause;
{$ENDIF}
HighAreah := HighArea;
GetATh := GetScrChar;
FillAreah := FillArea;
Scrollh := Scroll;
GotoXYh := SetXY;
WriteATh := WriteAT;
{$IFNDEF AVT0}
{ FlushInputh := <Defualt Zero keyboard buffer hook is fine> }
{$ENDIF}
end;